home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / scale.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  24.7 KB  |  802 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test out the "scale" command
  2. # of Tk.  It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # SCCS: @(#) scale.test 1.28 97/07/31 10:20:43
  11.  
  12. if {[info procs test] != "test"} {
  13.     source defs
  14. }
  15.  
  16. foreach i [winfo children .] {
  17.     destroy $i
  18. }
  19. wm geometry . {}
  20. raise .
  21.  
  22. # Create entries in the option database to be sure that geometry options
  23. # like border width have predictable values.
  24.  
  25. option add *Scale.borderWidth 2
  26. option add *Scale.highlightThickness 2
  27. option add *Scale.font {Helvetica -12 bold}
  28.  
  29. scale .s -from 100 -to 300
  30. pack .s
  31. update
  32. set i 1
  33. foreach test {
  34.     {-activebackground #ff0000 #ff0000 non-existent
  35.         {unknown color name "non-existent"}}
  36.     {-background #ff0000 #ff0000 non-existent
  37.         {unknown color name "non-existent"}}
  38.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  39.     {-bigincrement 12.5 12.5 badValue
  40.         {expected floating-point number but got "badValue"}}
  41.     {-bg #ff0000 #ff0000 non-existent
  42.         {unknown color name "non-existent"}}
  43.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  44.     {-command "set x" {set x} {} {}}
  45.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  46.     {-digits 5 5 badValue {expected integer but got "badValue"}}
  47.     {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}}
  48.     {-font fixed fixed {} {font "" doesn't exist}}
  49.     {-foreground green green badValue {unknown color name "badValue"}}
  50.     {-from -15.0 -15.0 badValue
  51.         {expected floating-point number but got "badValue"}}
  52.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  53.     {-highlightcolor #123456 #123456 non-existent
  54.         {unknown color name "non-existent"}}
  55.     {-highlightthickness 2 2 badValue {bad screen distance "badValue"}}
  56.     {-label "Some text" {Some text} {} {}}
  57.     {-length 130 130 badValue {bad screen distance "badValue"}}
  58.     {-orient horizontal horizontal badValue
  59.         {bad orientation "badValue": must be vertical or horizontal}}
  60.     {-orient horizontal horizontal {} {}}
  61.     {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
  62.     {-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
  63.     {-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
  64.     {-resolution 2.0 2.0 badValue
  65.         {expected floating-point number but got "badValue"}}
  66.     {-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
  67.     {-sliderlength 86 86 badValue {bad screen distance "badValue"}}
  68.     {-sliderrelief raised raised badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
  69.     {-state disabled disabled badValue
  70.         {bad state value "badValue": must be normal, active, or disabled}}
  71.     {-state normal normal {} {}}
  72.     {-takefocus "any string" "any string" {} {}}
  73.     {-tickinterval 4.3 4.0 badValue
  74.         {expected floating-point number but got "badValue"}}
  75.     {-to 14.9 15.0 badValue
  76.         {expected floating-point number but got "badValue"}}
  77.     {-troughcolor #ff0000 #ff0000 non-existent
  78.         {unknown color name "non-existent"}}
  79.     {-variable x x {} {}}
  80.     {-width 32 32 badValue {bad screen distance "badValue"}}
  81. } {
  82.     set name [lindex $test 0]
  83.     test scale-1.$i {configuration options} {
  84.     .s configure $name [lindex $test 1]
  85.     lindex [.s configure $name] 4
  86.     } [lindex $test 2]
  87.     incr i
  88.     if {[lindex $test 3] != ""} {
  89.     test scale-1.$i {configuration options} {
  90.         list [catch {.s configure $name [lindex $test 3]} msg] $msg
  91.     } [list 1 [lindex $test 4]]
  92.     }
  93.     .s configure $name [lindex [.s configure $name] 3]
  94.     incr i
  95. }
  96.  
  97. destroy .s
  98. test scale-2.1 {Tk_ScaleCmd procedure} {
  99.     list [catch {scale} msg] $msg
  100. } {1 {wrong # args: should be "scale pathName ?options?"}}
  101. test scale-2.2 {Tk_ScaleCmd procedure} {
  102.     list [catch {scale foo} msg] $msg [winfo child .]
  103. } {1 {bad window path name "foo"} {}}
  104. test scale-2.3 {Tk_ScaleCmd procedure} {
  105.     list [catch {scale .s -gorp dumb} msg] $msg [winfo child .]
  106. } {1 {unknown option "-gorp"} {}}
  107.  
  108. scale .s -from 100 -to 200
  109. pack .s
  110. update idletasks
  111. test scale-3.1 {ScaleWidgetCmd procedure} {
  112.     list [catch {.s} msg] $msg
  113. } {1 {wrong # args: should be ".s option ?arg arg ...?"}}
  114. test scale-3.2 {ScaleWidgetCmd procedure, cget option} {
  115.     list [catch {.s cget} msg] $msg
  116. } {1 {wrong # args: should be ".s cget option"}}
  117. test scale-3.3 {ScaleWidgetCmd procedure, cget option} {
  118.     list [catch {.s cget a b} msg] $msg
  119. } {1 {wrong # args: should be ".s cget option"}}
  120. test scale-3.4 {ScaleWidgetCmd procedure, cget option} {
  121.     list [catch {.s cget -gorp} msg] $msg
  122. } {1 {unknown option "-gorp"}}
  123. test scale-3.5 {ScaleWidgetCmd procedure, cget option} {
  124.     .s cget -highlightthickness
  125. } {2}
  126. test scale-3.6 {ScaleWidgetCmd procedure, configure option} {
  127.     list [llength [.s configure]] [lindex [.s configure] 5]
  128. } {33 {-borderwidth borderWidth BorderWidth 2 2}}
  129. test scale-3.7 {ScaleWidgetCmd procedure, configure option} {
  130.     list [catch {.s configure -foo} msg] $msg
  131. } {1 {unknown option "-foo"}}
  132. test scale-3.8 {ScaleWidgetCmd procedure, configure option} {
  133.     list [catch {.s configure -borderwidth 2 -bg} msg] $msg
  134. } {1 {value for "-bg" missing}}
  135. test scale-3.9 {ScaleWidgetCmd procedure, coords option} {
  136.     list [catch {.s coords a b} msg] $msg
  137. } {1 {wrong # args: should be ".s coords ?value?"}}
  138. test scale-3.10 {ScaleWidgetCmd procedure, coords option} {
  139.     list [catch {.s coords bad} msg] $msg
  140. } {1 {expected floating-point number but got "bad"}}
  141. test scale-3.11 {ScaleWidgetCmd procedure} {fonts} {
  142.     .s set 120
  143.     .s coords
  144. } {38 34}
  145. test scale-3.12 {ScaleWidgetCmd procedure, coords option} {fonts} {
  146.     .s configure -orient horizontal
  147.     update
  148.     .s set 120
  149.     .s coords
  150. } {34 31}
  151. .s configure -orient vertical
  152. update
  153. test scale-3.13 {ScaleWidgetCmd procedure, get option} {
  154.     list [catch {.s get a} msg] $msg
  155. } {1 {wrong # args: should be ".s get ?x y?"}}
  156. test scale-3.14 {ScaleWidgetCmd procedure, get option} {
  157.     list [catch {.s get a b c} msg] $msg
  158. } {1 {wrong # args: should be ".s get ?x y?"}}
  159. test scale-3.15 {ScaleWidgetCmd procedure, get option} {
  160.     list [catch {.s get a 11} msg] $msg
  161. } {1 {expected integer but got "a"}}
  162. test scale-3.16 {ScaleWidgetCmd procedure, get option} {
  163.     list [catch {.s get 12 b} msg] $msg
  164. } {1 {expected integer but got "b"}}
  165. test scale-3.17 {ScaleWidgetCmd procedure, get option} {
  166.     .s set 133
  167.     .s get
  168. } 133
  169. test scale-3.18 {ScaleWidgetCmd procedure, get option} {
  170.     .s configure -resolution 0.5
  171.     .s set 150
  172.     .s get 37 34
  173. } 119.5
  174. .s configure -resolution 1
  175. test scale-3.19 {ScaleWidgetCmd procedure, identify option} {
  176.     list [catch {.s identify} msg] $msg
  177. } {1 {wrong # args: should be ".s identify x y"}}
  178. test scale-3.20 {ScaleWidgetCmd procedure, identify option} {
  179.     list [catch {.s identify 1 2 3} msg] $msg
  180. } {1 {wrong # args: should be ".s identify x y"}}
  181. test scale-3.21 {ScaleWidgetCmd procedure, identify option} {
  182.     list [catch {.s identify boo 16} msg] $msg
  183. } {1 {expected integer but got "boo"}}
  184. test scale-3.22 {ScaleWidgetCmd procedure, identify option} {
  185.     list [catch {.s identify 17 bad} msg] $msg
  186. } {1 {expected integer but got "bad"}}
  187. test scale-3.23 {ScaleWidgetCmd procedure, identify option} {fonts} {
  188.     .s set 120
  189.     list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80]
  190. } {trough1 slider trough2 {}}
  191. test scale-3.24 {ScaleWidgetCmd procedure, set option} {
  192.     list [catch {.s set} msg] $msg
  193. } {1 {wrong # args: should be ".s set value"}}
  194. test scale-3.25 {ScaleWidgetCmd procedure, set option} {
  195.     list [catch {.s set a b} msg] $msg
  196. } {1 {wrong # args: should be ".s set value"}}
  197. test scale-3.26 {ScaleWidgetCmd procedure, set option} {
  198.     list [catch {.s set bad} msg] $msg
  199. } {1 {expected floating-point number but got "bad"}}
  200. test scale-3.27 {ScaleWidgetCmd procedure, set option} {
  201.     .s set 142
  202. } {}
  203. test scale-3.28 {ScaleWidgetCmd procedure, set option} {
  204.     .s set 118
  205.     .s configure -state disabled
  206.     .s set 181
  207.     .s configure -state normal
  208.     .s get
  209. } {118}
  210. test scale-3.29 {ScaleWidgetCmd procedure} {
  211.     list [catch {.s dumb} msg] $msg
  212. } {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
  213. test scale-3.30 {ScaleWidgetCmd procedure} {
  214.     list [catch {.s c} msg] $msg
  215. } {1 {bad option "c": must be cget, configure, coords, get, identify, or set}}
  216. test scale-3.31 {ScaleWidgetCmd procedure} {
  217.     list [catch {.s co} msg] $msg
  218. } {1 {bad option "co": must be cget, configure, coords, get, identify, or set}}
  219. test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
  220.     proc kill args {
  221.     destroy .s
  222.     }
  223.     catch {destroy .s}
  224.     scale .s -variable x -from 0 -to 100 -orient horizontal
  225.     pack .s
  226.     update
  227.     .s configure -command kill
  228.     .s set 55
  229. } {}
  230.  
  231. test scale-4.1 {DestroyScale procedure} {
  232.     catch {destroy .s}
  233.     set x 50
  234.     scale .s -variable x -from 0 -to 100 -orient horizontal
  235.     pack .s
  236.     update
  237.     destroy .s
  238.     list [catch {set x foo} msg] $msg $x
  239. } {0 foo foo}
  240.  
  241. test scale-5.1 {ConfigureScale procedure} {
  242.     catch {destroy .s}
  243.     set x 66
  244.     set y 77
  245.     scale .s -variable x -from 0 -to 100
  246.     pack .s
  247.     update
  248.     .s configure -variable y
  249.     list [catch {set x foo} msg] $msg $x [.s get]
  250. } {0 foo foo 77}
  251. test scale-5.2 {ConfigureScale procedure} {
  252.     catch {destroy .s}
  253.     scale .s -from 0 -to 100
  254.     list [catch {.s configure -foo bar} msg] $msg
  255. } {1 {unknown option "-foo"}}
  256. test scale-5.3 {ConfigureScale procedure} {
  257.     catch {destroy .s}
  258.     catch {unset x}
  259.     scale .s -from 0 -to 100 -variable x
  260.     set result $x
  261.     lappend result [.s get]
  262.     set x 92
  263.     lappend result [.s get]
  264.     .s set 3
  265.     lappend result $x
  266.     unset x
  267.     lappend result [catch {set x} msg] $msg
  268. } {0 0 92 3 0 3}
  269. test scale-5.4 {ConfigureScale procedure} {
  270.     catch {destroy .s}
  271.     scale .s -from 0 -to 100
  272.     list [catch {.s configure -orient dumb} msg] $msg
  273. } {1 {bad orientation "dumb": must be vertical or horizontal}}
  274. test scale-5.5 {ConfigureScale procedure} {
  275.     catch {destroy .s}
  276.     scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
  277.     list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \
  278.         [format %.1f [.s cget -tickinterval]]
  279. } {1.1 1.9 0.8}
  280. test scale-5.6 {ConfigureScale procedure} {
  281.     catch {destroy .s}
  282.     scale .s -from 1 -to 10 -tickinterval -2
  283.     pack .s
  284.     set result [lindex [.s configure -tickinterval] 4]
  285.     .s configure -from 10 -to 1 -tickinterval 2
  286.     lappend result [lindex [.s configure -tickinterval] 4]
  287. } {2.0 -2.0}
  288. test scale-5.7 {ConfigureScale procedure} {
  289.     catch {destroy .s}
  290.     list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
  291. } {1 {bad state value "bogus": must be normal, active, or disabled}}
  292.  
  293. catch {destroy .s}
  294. scale .s -orient horizontal -length 200
  295. pack .s
  296. test scale-6.1 {ComputeFormat procedure} {
  297.     .s configure -from 10 -to 100 -resolution 10
  298.     .s set 49.3
  299.     .s get
  300. } {50}
  301. test scale-6.2 {ComputeFormat procedure} {
  302.     .s configure -from 100 -to 1000 -resolution 100
  303.     .s set 493
  304.     .s get
  305. } {500}
  306. test scale-6.3 {ComputeFormat procedure} {
  307.     .s configure -from 1000 -to 10000 -resolution 1000
  308.     .s set 4930
  309.     .s get
  310. } {5000}
  311. test scale-6.4 {ComputeFormat procedure} {
  312.     .s configure -from 10000 -to 100000 -resolution 10000
  313.     .s set 49000
  314.     .s get
  315. } {50000}
  316. test scale-6.5 {ComputeFormat procedure} {
  317.     .s configure -from 100000 -to 1000000 -resolution 100000
  318.     .s set 493000
  319.     .s get
  320. } {500000}
  321. test scale-6.6 {ComputeFormat procedure} {nonPortable} {
  322.     # This test is non-portable because some platforms format the
  323.     # result as 5e+06.
  324.  
  325.     .s configure -from 1000000 -to 10000000 -resolution 1000000
  326.     .s set 4930000
  327.     .s get
  328. } {5000000}
  329. test scale-6.7 {ComputeFormat procedure} {
  330.     .s configure -from 1000000000 -to 10000000000 -resolution 1000000000
  331.     .s set 4930000000
  332.     .s get
  333. } {5.0e+09}
  334. test scale-6.8 {ComputeFormat procedure} {
  335.     .s configure -from .1 -to 1 -resolution .1
  336.     .s set .6
  337.     .s get
  338. } {0.6}
  339. test scale-6.9 {ComputeFormat procedure} {
  340.     .s configure -from .01 -to .1 -resolution .01
  341.     .s set .06
  342.     .s get
  343. } {0.06}
  344. test scale-6.10 {ComputeFormat procedure} {
  345.     .s configure -from .001 -to .01 -resolution .001
  346.     .s set .006
  347.     .s get
  348. } {0.006}
  349. test scale-6.11 {ComputeFormat procedure} {
  350.     .s configure -from .0001 -to .001 -resolution .0001
  351.     .s set .0006
  352.     .s get
  353. } {0.0006}
  354. test scale-6.12 {ComputeFormat procedure} {
  355.     .s configure -from .00001 -to .0001 -resolution .00001
  356.     .s set .00006
  357.     .s get
  358. } {0.00006}
  359. test scale-6.13 {ComputeFormat procedure} {
  360.     .s configure -from .000001 -to .00001 -resolution .000001
  361.     .s set .000006
  362.     .s get
  363. } {6.0e-06}
  364. test scale-6.14 {ComputeFormat procedure} {
  365.     .s configure -to .00001 -from .0001 -resolution .00001
  366.     .s set .00006
  367.     .s get
  368. } {0.00006}
  369. test scale-6.15 {ComputeFormat procedure} {
  370.     .s configure -to .000001 -from .00001 -resolution .000001
  371.     .s set .000006
  372.     .s get
  373. } {6.0e-06}
  374. test scale-6.16 {ComputeFormat procedure} {
  375.     .s configure -from .00001 -to .0001 -resolution .00001 -digits 1
  376.     .s set .00006
  377.     .s get
  378. } {6e-05}
  379. test scale-6.17 {ComputeFormat procedure} {
  380.     .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
  381.     .s set 49300000
  382.     .s get
  383. } {50000000}
  384. test scale-6.18 {ComputeFormat procedure} {
  385.     .s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0
  386.     .s set .111111111
  387.     .s get
  388. } {0.11}
  389. test scale-6.19 {ComputeFormat procedure} {
  390.     .s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0
  391.     .s set 1001.23456789
  392.     .s get
  393. } {1001.23}
  394. test scale-6.20 {ComputeFormat procedure} {
  395.     .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0
  396.     .s set 1001.23456789
  397.     .s get
  398. } {1001.235}
  399.  
  400. test scale-7.1 {ComputeScaleGeometry procedure} {fonts} {
  401.     catch {destroy .s}
  402.     scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i
  403.     pack .s
  404.     update
  405.     list [winfo reqwidth .s] [winfo reqheight .s]
  406. } {88 458}
  407. test scale-7.2 {ComputeScaleGeometry procedure} {fonts} {
  408.     catch {destroy .s}
  409.     scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200
  410.     pack .s
  411.     update
  412.     list [winfo reqwidth .s] [winfo reqheight .s]
  413. } {168 108}
  414. test scale-7.3 {ComputeScaleGeometry procedure} {fonts} {
  415.     catch {destroy .s}
  416.     scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \
  417.         -sliderlength 10
  418.     pack .s
  419.     update
  420.     list [winfo reqwidth .s] [winfo reqheight .s]
  421. } {22 108}
  422. test scale-7.4 {ComputeScaleGeometry procedure} {fonts} {
  423.     catch {destroy .s}
  424.     scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \
  425.         -relief sunken
  426.     pack .s
  427.     update
  428.     list [winfo reqwidth .s] [winfo reqheight .s]
  429. } {39 114}
  430. test scale-7.5 {ComputeScaleGeometry procedure} {fonts} {
  431.     catch {destroy .s}
  432.     scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i
  433.     pack .s
  434.     update
  435.     list [winfo reqwidth .s] [winfo reqheight .s]
  436. } {458 61}
  437. test scale-7.6 {ComputeScaleGeometry procedure} {fonts} {
  438.     catch {destroy .s}
  439.     scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \
  440.         -tick 500
  441.     pack .s
  442.     update
  443.     list [winfo reqwidth .s] [winfo reqheight .s]
  444. } {108 79}
  445. test scale-7.7 {ComputeScaleGeometry procedure} {fonts} {
  446.     catch {destroy .s}
  447.     scale .s -from 0 -to 1000 -orient horizontal -showvalue 0
  448.     pack .s
  449.     update
  450.     list [winfo reqwidth .s] [winfo reqheight .s]
  451. } {108 27}
  452. test scale-7.8 {ComputeScaleGeometry procedure} {
  453.     catch {destroy .s}
  454.     scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \
  455.         -relief raised -highlightthickness 2
  456.     pack .s
  457.     update
  458.     list [winfo reqwidth .s] [winfo reqheight .s]
  459. } {114 39}
  460.  
  461. test scale-8.1 {ScaleElement procedure} {fonts} {
  462.     catch {destroy .s}
  463.     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
  464.     pack .s
  465.     .s set 30
  466.     update
  467.     list [.s identify 53 52] [.s identify 54 52] [.s identify 70 52] \
  468.         [.s identify 71 52]
  469. } {{} trough1 trough1 {}}
  470. test scale-8.2 {ScaleElement procedure} {fonts} {
  471.     catch {destroy .s}
  472.     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
  473.     pack .s
  474.     .s set 30
  475.     update
  476.     list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] \
  477.         [.s identify 60 303]
  478. } {{} trough1 trough2 {}}
  479. test scale-8.3 {ScaleElement procedure} {fonts} {
  480.     catch {destroy .s}
  481.     scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
  482.     pack .s
  483.     .s set 30
  484.     update
  485.     list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] \
  486.         [.s identify 60 114] \
  487. } {trough1 slider slider trough2}
  488. test scale-8.4 {ScaleElement procedure} {
  489.     catch {destroy .s}
  490.     scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \
  491.         -highlightthickness 1 -length 300 -showvalue 0
  492.     pack .s
  493.     .s set 30
  494.     update
  495.     list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] \
  496.         [.s identify 23 40] \
  497. } {{} trough1 trough1 {}}
  498. test scale-8.5 {ScaleElement procedure} {fonts} {
  499.     catch {destroy .s}
  500.     scale .s -from 0 -to 100 -orient horizontal -bd 1 \
  501.         -highlightthickness 2 -tick 20 -sliderlength 20 \
  502.         -length 200 -label Test
  503.     pack .s
  504.     .s set 30
  505.     update
  506.     list [.s identify 150 36] [.s identify 150 37] [.s identify 150 53] \
  507.         [.s identify 150 54]
  508. } {{} trough2 trough2 {}}
  509. test scale-8.6 {ScaleElement procedure} {fonts} {
  510.     catch {destroy .s}
  511.     scale .s -from 0 -to 100 -orient horizontal -bd 2 \
  512.         -highlightthickness 1 -tick 20 -length 200
  513.     pack .s
  514.     .s set 30
  515.     update
  516.     list [.s identify 150 20] [.s identify 150 21] [.s identify 150 39] \
  517.         [.s identify 150 40]
  518. } {{} trough2 trough2 {}}
  519. test scale-8.7 {ScaleElement procedure} {
  520.     catch {destroy .s}
  521.     scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \
  522.         -length 200 -width 10 -showvalue 0
  523.     pack .s
  524.     .s set 30
  525.     update
  526.     list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] \
  527.         [.s identify 30 24]
  528. } {{} trough1 trough1 {}}
  529. test scale-8.8 {ScaleElement procedure} {
  530.     catch {destroy .s}
  531.     scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
  532.         -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
  533.     pack .s
  534.     .s set 30
  535.     update
  536.     list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] \
  537.         [.s identify 203 28]
  538. } {{} trough1 trough2 {}}
  539. test scale-8.9 {ScaleElement procedure} {
  540.     catch {destroy .s}
  541.     scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
  542.         -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
  543.     pack .s
  544.     .s set 80
  545.     update
  546.     list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] \
  547.         [.s identify 166 28]
  548. } {trough1 slider slider trough2}
  549.  
  550. catch {destroy .s}
  551. scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
  552. pack .s
  553. update
  554. test scale-9.1 {PixelToValue procedure} {
  555.     .s get 46 0
  556. } 0
  557. test scale-9.2 {PixelToValue procedure} {
  558.     .s get -10 9
  559. } 0
  560. test scale-9.3 {PixelToValue procedure} {
  561.     .s get -10 12
  562. } 1
  563. test scale-9.4 {PixelToValue procedure} {
  564.     .s get -10 46
  565. } 35
  566. test scale-9.5 {PixelToValue procedure} {
  567.     .s get -10 110
  568. } 99
  569. test scale-9.6 {PixelToValue procedure} {
  570.     .s get -10 111
  571. } 100
  572. test scale-9.7 {PixelToValue procedure} {
  573.     .s get -10 112
  574. } 100
  575. test scale-9.8 {PixelToValue procedure} {
  576.     .s get -10 154
  577. } 100
  578. .s configure -orient horizontal
  579. update
  580. test scale-9.9 {PixelToValue procedure} {
  581.     .s get 76 152
  582. } 65
  583.  
  584. test scale-10.1 {ValueToPixel procedure} {fonts} {
  585.     catch {destroy .s}
  586.     scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \
  587.         -orient horizontal -label Test -tick 20
  588.     pack .s
  589.     update
  590.     list [.s coords -10] [.s coords 40] [.s coords 1000]
  591. } {{16 47} {56 47} {116 47}}
  592. test scale-10.2 {ValueToPixel procedure} {fonts} {
  593.     catch {destroy .s}
  594.     scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \
  595.         -orient vertical -label Test -tick 20
  596.     pack .s
  597.     update
  598.     list [.s coords -10] [.s coords 40] [.s coords 1000]
  599. } {{62 114} {62 74} {62 14}}
  600.  
  601. test scale-11.1 {ScaleEventProc procedure} {
  602.     proc killScale value {
  603.     global x
  604.     if {$value > 30} {
  605.         destroy .s1
  606.         lappend x [winfo exists .s1] [info commands .s1]
  607.     }
  608.     }
  609.     catch {destroy .s1}
  610.     set x initial
  611.     scale .s1 -from 0 -to 100 -command killScale
  612.     .s1 set 20
  613.     pack .s1
  614.     update idletasks
  615.     lappend x [winfo exists .s1]
  616.     .s1 set 40
  617.     update idletasks
  618.     rename killScale {}
  619.     set x
  620. } {initial 1 0 {}}
  621. test scale-11.2 {ScaleEventProc procedure} {
  622.     eval destroy [winfo children .]
  623.     scale .s1 -bg #543210
  624.     rename .s1 .s2
  625.     set x {}
  626.     lappend x [winfo children .]
  627.     lappend x [.s2 cget -bg]
  628.     destroy .s1
  629.     lappend x [info command .s*] [winfo children .]
  630. } {.s1 #543210 {} {}}
  631.  
  632. test scale-12.1 {ScaleCmdDeletedProc procedure} {
  633.     eval destroy [winfo children .]
  634.     scale .s1
  635.     rename .s1 {}
  636.     list [info command .s*] [winfo children .]
  637. } {{} {}}
  638.  
  639. catch {destroy .s}
  640. scale .s -from 0 -to 100 -command {set x} -variable y
  641. pack .s
  642. update
  643. proc varTrace args {
  644.     global traceInfo
  645.     set traceInfo $args
  646. }
  647. test scale-13.1 {SetScaleValue procedure} {
  648.     set x xyzzy
  649.     .s set 44
  650.     set result [list $x $y]
  651.     update
  652.     lappend result $x $y
  653. } {xyzzy 44 44 44}
  654. test scale-13.2 {SetScaleValue procedure} {
  655.     .s set -3
  656.     .s get
  657. } 0
  658. test scale-13.3 {SetScaleValue procedure} {
  659.     .s set 105
  660.     .s get
  661. } 100
  662. .s configure -from 100 -to 0
  663. test scale-13.4 {SetScaleValue procedure} {
  664.     .s set -3
  665.     .s get
  666. } 0
  667. test scale-13.5 {SetScaleValue procedure} {
  668.     .s set 105
  669.     .s get
  670. } 100
  671. test scale-13.6 {SetScaleValue procedure} {
  672.     .s set 50
  673.     update
  674.     trace variable y w varTrace
  675.     set traceInfo empty
  676.     set x untouched
  677.     .s set 50
  678.     update
  679.     list $x $traceInfo
  680. } {untouched empty}
  681.  
  682. catch {destroy .s}
  683. scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal
  684. pack .s
  685. update
  686. .s configure -resolution 4.0
  687. update
  688. test scale-14.1 {RoundToResolution procedure} {
  689.     .s get 84 152
  690. } 72
  691. test scale-14.2 {RoundToResolution procedure} {
  692.     .s get 86 152
  693. } 76
  694. .s configure -from 100 -to 0
  695. update
  696. test scale-14.3 {RoundToResolution procedure} {
  697.     .s get 84 152
  698. } 28
  699. test scale-14.4 {RoundToResolution procedure} {
  700.     .s get 86 152
  701. } 24
  702. .s configure -from -100 -to 0
  703. update
  704. test scale-14.5 {RoundToResolution procedure} {
  705.     .s get 84 152
  706. } -28
  707. test scale-14.6 {RoundToResolution procedure} {
  708.     .s get 86 152
  709. } -24
  710. .s configure -from 0 -to -100
  711. update
  712. test scale-14.7 {RoundToResolution procedure} {
  713.     .s get 84 152
  714. } -72
  715. test scale-14.8 {RoundToResolution procedure} {
  716.     .s get 86 152
  717. } -76
  718. .s configure -from 0 -to 2.25 -resolution 0
  719. update
  720. test scale-14.9 {RoundToResolution procedure} {
  721.     .s get 84 152
  722. } 1.64
  723. test scale-14.10 {RoundToResolution procedure} {
  724.     .s get 86 152
  725. } 1.69
  726. .s configure -from 0 -to 225 -resolution 0  -digits 5
  727. update
  728. test scale-14.11 {RoundToResolution procedure} {
  729.     .s get 84 152
  730. } 164.25
  731. test scale-14.12 {RoundToResolution procedure} {
  732.     .s get 86 152
  733. } 168.75
  734.  
  735. test scale-15.1 {ScaleVarProc procedure} {
  736.     catch {destroy .s}
  737.     set y -130
  738.     scale .s -from 0 -to -200 -variable y -orient horizontal -length 150
  739.     pack .s
  740.     set y
  741. } -130
  742. test scale-15.2 {ScaleVarProc procedure} {
  743.     catch {destroy .s}
  744.     set y -130
  745.     scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
  746.     pack .s
  747.     set y -87
  748.     .s get
  749. } -87
  750. test scale-15.3 {ScaleVarProc procedure} {
  751.     catch {destroy .s}
  752.     set y -130
  753.     scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
  754.     pack .s
  755.     list [catch {set y 40q} msg] $msg [.s get]
  756. } {1 {can't set "y": can't assign non-numeric value to scale variable} -130}
  757. test scale-15.4 {ScaleVarProc procedure} {
  758.     catch {destroy .s}
  759.     set y 1
  760.     scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
  761.     pack .s
  762.     list [catch {set y x} msg] $msg [.s get]
  763. } {1 {can't set "y": can't assign non-numeric value to scale variable} 1}
  764. test scale-15.5 {ScaleVarProc procedure, variable deleted} {
  765.     catch {destroy .s}
  766.     set y 6
  767.     scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 \
  768.         -command "set x"
  769.     pack .s
  770.     update
  771.     set x untouched
  772.     unset y
  773.     update
  774.     list [catch {set y} msg] $msg [.s get] $x
  775. } {0 6 6 untouched}
  776. test scale-15.6 {ScaleVarProc procedure, don't call -command} {
  777.     catch {destroy .s}
  778.     set y 6
  779.     scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 \
  780.         -command "set x"
  781.     pack .s
  782.     update
  783.     set x untouched
  784.     set y 60
  785.     update
  786.     list $x [.s get]
  787. } {untouched 60}
  788.  
  789. set l [interp hidden]
  790. eval destroy [winfo children .]
  791.  
  792. test scale-16.1 {scale widget vs hidden commands} {
  793.     catch {destroy .s}
  794.     scale .s
  795.     interp hide {} .s
  796.     destroy .s
  797.     list [winfo children .] [interp hidden]
  798. } [list {} $l]
  799.  
  800. catch {destroy .s}
  801. option clear
  802.